home *** CD-ROM | disk | FTP | other *** search
/ DS-CD ROM 2 1993 August / DS CD-ROM 2.Ausgabe (August 1993).iso / programm / ds0045 / mbm_src.exe / MB_DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-22  |  9KB  |  236 lines
  1. program maus_button_demo;
  2. {$S-}                      {Vollversion 4.1 vom 09.07.1991}
  3.                            {(C) 1990-92 Software-Entwicklung Uwe Kuhring}
  4.  
  5. uses  drv_link,crt,graph,butlib,mouselib,winlib;
  6.  
  7. const pieces = 25;                             {Anzahl der Kreisbuttons}
  8.                                                {auf Ebene 2}
  9. var   plane  : integer;                        {Enthält aktuelle Ebene}
  10.  
  11. {Es folgen die Prozeduren}
  12.  
  13. procedure mousetest;
  14. var buttons : integer;
  15. begin
  16. mousecheck(buttons);                           {Anzahl der Mausknöpfe holen}
  17. if mouseerror<0 then begin                     {Keine Maus oder k. Grafik}
  18.    case mouseerror of
  19.         -1 : begin
  20.                 writeln ('Kein Grafikmodus aktiviert!');  {ohne gehts nun}
  21.                 exit;                                     {wirklich nicht}
  22.                 end;
  23.         -2 : begin                             {Keine Maus festgestellt}
  24.              end;                              {Reaktion freigestellt ...}
  25.         end;
  26.    end;
  27. end;
  28.  
  29. procedure install_buttonplane_1;
  30. begin
  31.              { ┌--Button-Ebene}
  32.              { │ ┌--Button-Nummer}
  33.              { │ │ ┌--X Textspalte}
  34.              { │ │ │ ┌--Y Textzeile}
  35.              { │ │ │ │         ┌---Text im Button}
  36.              { │ │ │ │         │          ┌---Shadowing an/aus ^ true/false}
  37.              { │ │ │ │         │          │    ┌-----ALT ? Button Aktivator}
  38.              { │ │ │ │         │          │    │  ┌------Underline Position}
  39. deftextbutton (1,1,3,3,' Soundschalter ',true,'S',2);
  40. deftextbutton (1,2,3,5,'  Frequenz +   ',true,'Q',6);
  41. deftextbutton (1,3,3,7,'  Frequenz -   ',true,'U',7);
  42. deftextbutton (1,4,62,3,' Maus einsperren ',true,'E',7);
  43. deftextbutton (1,5,62,5,' Maus freilassen ',true,'F',7);
  44. deftextbutton (1,6,34,12,' Zur Ebene 2 ',true,'2',12);
  45. deftextbutton (1,7,3,21,' Maus 3 Sekunden ausschalten ',true,'3',7);
  46. deftextbutton (1,8,56,21,' Maus-Button Demo Ende ',true,'M',2);
  47. deftextbutton (1,9,3,12,' Teleport A ',true,'A',11);
  48. deftextbutton (1,10,67,12,' Teleport B ',true,'B',11);
  49. deftextbutton (1,11,38,21,' Kurzinfo ',true,'K',2);
  50. end;
  51.  
  52. procedure install_buttonplane_2;
  53. var n,x,y : integer;
  54.     t     : string;
  55. begin
  56. for n:=1 to pieces do begin
  57.     x:=39+round(sin(n*2*pi/pieces)*35);
  58.     y:=12+round(cos(n*2*pi/pieces)*10);
  59.     str (n:2,t);
  60.     deftextbutton (2,n,x,y,t,false,' ',0);   { <- so gehts auch}
  61.     end;
  62. deftextbutton (2,pieces+1,34,12,' Zur Ebene 1 ',true,'1',12);
  63. end;
  64.  
  65. procedure install_colors;
  66. var t : integer;
  67. begin
  68. button_colors[1,8,0]:=4;         {Hintergrundfarbe des Ende-Buttons ist Rot}
  69. button_colors[1,6,0]:=5;         { " des Buttons zum Ebene-Wechseln ist Vio}
  70. button_colors[1,11,0]:=3;        { " des Kurzinfo-Buttons ist Cyan}
  71. button_colors[1,11,2]:=11;        {Zeichenfarbe des " ist hellblau}
  72. button_colors[1,11,1]:=14;        {Rahmenfarbe des " ist gelb}
  73. randomize;
  74. for t:=1 to pieces do begin      {Zufallsfarben für die Buttons v. Ebene 2}
  75.     button_colors [2,t,0]:=random(16);      {Hintergrundfarbe}
  76.     button_colors [2,t,1]:=random(16);      {Umrandungsfarbe}
  77.     repeat
  78.        button_colors [2,t,2]:=random(16);   {Textfarbe}
  79.        until button_colors[2,t,2]<>button_colors[2,t,0];
  80.     end;
  81. end;
  82.  
  83. procedure clearmouse;
  84. var a,b,c : integer;
  85. begin
  86. repeat mousestat(a,b,c) until c=0 ;   {alle Mausknöpfe loslassen}
  87. end;
  88.  
  89. procedure call_plane_1;
  90. var t,button,mb,hz : integer;
  91.     snd            : boolean;
  92.     mychar         : char;
  93. begin
  94. hz:=30 ; snd:=false ; mychar:=chr(255);
  95. clearmouse;
  96.  
  97. mouseoff;
  98. if vga_ega_card then begin
  99.    setfillstyle(1,7);
  100.    bar(0,0,getmaxx,getmaxy)                {Bildschirm füllen}
  101.    end
  102. else cleardevice;                          {oder löschen}
  103. mouseon;
  104. defbuttonplane(1);                         {1. Ebene anzeigen lassen}
  105.  
  106. line (2*getmaxx div 3,0,2*getmaxx div 3,getmaxy div 3);
  107. line (2*getmaxx div 3,getmaxy div 3,2*getmaxx,getmaxy div 3);
  108.  
  109. repeat
  110.    if keypressed then mychar:=readkey;           {Tastatur lesen}
  111.    if ord(mychar)=0 then begin                   {Test auf erw. Tast.-Code}
  112.       if keypressed then mychar:=readkey         {Erw. Code holen}
  113.       else mychar:=chr(255);                     {oder mychar auf 255}
  114.       end
  115.    else mychar:=chr(255);                        {255 heißt : keine Aktion}
  116.    pressedbutton(button,mb,mychar);              {Buttons überprüfen lassen}
  117.    if mb<>0 then begin                           {User hat Mausbutton gedr.}
  118.       case button of                             {bzw. ALT ? gedrückt}
  119.       0 : ;                                      {in button steht der gedr.}
  120.       1 : begin                                  {Button - es folgt Reaktion}
  121.              revertbutton(1) ; clearmouse;
  122.              if snd then nosound
  123.              else sound(hz);                     {Soundschalter}
  124.              snd:=not snd;
  125.              revertbutton(1);
  126.              end;
  127.       2 : begin
  128.              revertbutton(2);
  129.              hz:=hz+1;
  130.              if hz>10000 then hz:=10000;
  131.              if snd then sound(hz);              {Frequenz +}
  132.              revertbutton(2);
  133.              end;
  134.       3 : begin
  135.              revertbutton(3);
  136.              hz:=hz-1;
  137.              if hz<15 then hz:=15;
  138.              if snd then sound(hz);              {Frequenz -}
  139.              revertbutton(3);
  140.              end;
  141.       4 : begin                                  {Mousewindow}
  142.              revertbutton(4) ; clearmouse ;
  143.              mousewindow (2*getmaxx div 3,0,getmaxx,getmaxy div 3-2) ;
  144.              revertbutton(4);
  145.              end;
  146.       5 : begin
  147.              revertbutton(5) ; clearmouse ;      {Freie Maus}
  148.              mousewindow (0,0,getmaxx,getmaxy);
  149.              revertbutton(5);
  150.              end;
  151.       6 : plane:=2;                              {Ebenenumschaltung}
  152.       7 : begin
  153.              revertbutton(7);                    {Abwarten}
  154.              mouseoff ; delay (3000) ; mouseon;
  155.              revertbutton(7);
  156.              end;
  157.       8 : plane:=0 ;                              {Porgramm verlassen}
  158.       9 : begin
  159.              revertbutton(9);
  160.              mouseset(round(70/80*getmaxx),round(12.2/25*getmaxy));
  161.              revertbutton(9);
  162.              clearmouse;                          {1. Teleport}
  163.              end;
  164.      10 : begin
  165.              revertbutton(10);
  166.              mouseset(round(9/80*getmaxx),round(12.2/25*getmaxy));
  167.              revertbutton(10);
  168.              clearmouse;                          {2. Teleport}
  169.              end;
  170.      11 : begin
  171.              revertbutton(11);
  172.              info_window('!','Ein solches Fenster ist mit'
  173.                             ,'einem einzigen Befehl schnell'
  174.                             ,'und einfach zu öffnen!');
  175.              revertbutton(11);
  176.              clearmouse;                          {Kurzinfo}
  177.              end;
  178.       end;
  179.    end;
  180. until plane<>1;
  181. if snd then begin
  182.    revertbutton(1) ; snd:=false ; nosound;
  183.    end;
  184. end;
  185.  
  186. procedure call_plane_2;
  187. var t,button,mb : integer;
  188.     mychar      : char;
  189. begin
  190. clearmouse;
  191. mychar:=chr(255);                                 {Zeichen für "nichts los"}
  192. mouseoff ; cleardevice ; mouseon;
  193. defbuttonplane(2);
  194. repeat
  195.   for t:=1 to pieces do begin
  196.     if keypressed then mychar:=readkey;           {Tastatur lesen}
  197.     if ord(mychar)=0 then begin                   {Test auf erw. Tast.-Code}
  198.        if keypressed then mychar:=readkey         {Erw. Code holen}
  199.        else mychar:=chr(255);                     {oder mychar auf 255}
  200.        end
  201.     else mychar:=chr(255);                        {255 heißt : keine Aktion}
  202.     pressedbutton(button,mb,mychar);              {Buttons überprüfen lassen}
  203.     if (mb=1) and (button=pieces+1) then begin
  204.       plane:=1 ; exit ; end;
  205.     revertbutton(t); delay(20);
  206.     end;
  207.   until false;
  208. end;
  209.  
  210.  
  211. {Hauptprogramm}
  212.  
  213. begin
  214. enter_default_graphmode;                    {Standard-Grafikmodus auswählen}
  215. cleardevice;                                {Bildschirm löschen}
  216. mousetest;                                  {Anwesenheit der Maus ermitteln}
  217. install_buttonplane_1;                      {Buttons der Ebene 1 definieren}
  218. install_buttonplane_2;                      {Buttons der Ebene 2 definieren}
  219. if vga_ega_card then install_colors;        {Eventuell Farben definieren}
  220. mouseon;                                    {Maus einschalten}
  221. plane:=1;                                   {Start auf Ebene 1}
  222.  
  223. repeat
  224. case plane of
  225.  
  226.      1 : call_plane_1 ;                     {Ebene 1 aufrufen}
  227.      2 : call_plane_2 ;                     {Ebene 2 aufrufen}
  228.  
  229.      end;
  230.  
  231. until plane=0;                              {Ebene 0 steht für Demo-Ende}
  232.  
  233. mouseoff;                                   {Maus wieder abschalten}
  234. cleardevice;                                {Den Grafikbildschirm löschen}
  235. closegraph;                                 {Grafikmodus wieder verlassen}
  236. end.                                        {Programmende}